home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / C64 / T-TPUG Old Monthly Disks / (c)td.d64 / survey assist.c (.txt) < prev    next >
Commodore BASIC  |  2007-02-04  |  8KB  |  309 lines
  1. 100 REM"[184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184][184]
  2. 110 [143]"      (null)(null)(null)(null)VAL(null) ATN(null)(null)RIGHT$(null)(null)ATN(null)(null)
  3. 120 REM"          BY
  4. 130 [143]"      MID$IM (null)'LEFT$ARE
  5. 140 REM"      303 [199]OVERNMENT [211]T.
  6. 150 [143]"      (null)ICTORIA, PEEK.LEN. (null)8(null) 2(null)3
  7. 160 REM"      [211]EPTEMBER 1984
  8. 170 [143]"POSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOSPOS
  9. 180 :
  10. 190 B=53280:S=53281:C=646:REM SCREEN COLOURS
  11. 200 POKE 53272,23:REM UPPER/LOWER CASE
  12. 210 REM N$=COMPANY NAME J$=JOB NAME
  13. 220 REM M$=MONTH D$=DAY Y$=YEAR
  14. 230 :
  15. 240 REM"**-[198][201][210][211][212][160][211][195][210][197][197][206]--**
  16. 250 :
  17. 260 [153][199](147):[151]B,6:[151]S,6:[151]C,1
  18. 270 CD[178]5:[141]9000
  19. 280 NN$[178]"(null)URVEY ATNSSISTANT"
  20. 290 [153][166]20[171]([195](NN$)[173]2))NN$:[153]
  21. 300 NN$[178]"BY"
  22. 310 [153][166]20[171]([195](NN$)[173]2))NN$:[153]
  23. 320 NN$[178]"MID$IM (null)'LEFT$ARE"
  24. 330 [153][166]20[171]([195](NN$)[173]2))NN$
  25. 340 [153]"":CD[178]23:[141]9000
  26. 350 [153] [166]7)[199](18)"PRESS ANY KEY TO CONTINUE"[199](146)
  27. 360 [141]15000:[143] SOUND
  28. 370 [161]Z$:[139]Z$[178]""[167]370
  29. 380 :
  30. 390 [143]"**--(null)ATN(null)(null)CLOSERIGHT$(null)(null)(null)(null)(null)LEN(null)RIGHT$(null)(null)(null)?--**
  31. 400 :
  32. 410 PRINTCHR$(147):CD=5:GOSUB9000
  33. 420 PRINTSPC(5)"[196]O YOU WANT INSTRUCTIONS?":PRINT""
  34. 430 GOSUB 8000
  35. 440 IF YES$="Y"THENGOSUB10000
  36. 450 POKEB,6:POKES,6:POKEC,1
  37. 460 PRINTCHR$(147):CD=5:GOSUB9000
  38. 470 PRINT"[196]O YOU WANT TO PRODUCE THE RANDOM"
  39. 480 PRINT"NUMBER LIST FROM A PREVIOUSLY"
  40. 490 PRINT"CREATED DATA FILE?":PRINT"": GOSUB8000
  41. 500 IFYES$="N"THEN GOTO730
  42. 510 PRINT"[197]NTER NAME OF FILE TO RETRIEVE"
  43. 520 INPUT FILE$
  44. 530 :
  45. 540 REM"**--[210][197][193][196][160][198][201][204][197]--**
  46. 550 :
  47. 560 [153]"": [153][199](18)"(null)(null)VALATN(null)VALCLOSE(null)ATNRIGHT$(null)CLOSEATNCLOSE(null)(null)(null)VAL(null)(null)"[199](146)
  48. 570 [159]2,8,2,"0:"[170]FILE$[170]".PT"[170]",S,R"
  49. 580 [132]2,PN
  50. 585 [139]ST[177]64[167][160]2: [159]15,8,15:[132]15,X$:[160]15:[137]600
  51. 590 [160]2
  52. 600 [153]:[139]PN[178]0[167] [153][199](18) "SYSASCRIGHT$(null)VALCLOSESTR$(null)VAL(null)CLOSE(null)(null)(null)CLOSEVAL(null)RIGHT$(null)(null)"[199](146):[137]510
  53. 610 [159]3,8,3,"0:"[170]FILE$[170]",S,R"
  54. 620 [134] PD(PN)
  55. 630 [129]J[178]1 [164] PN
  56. 640 [132]3,PD(J)
  57. 650 [130]J
  58. 660 [160]3
  59. 670 [153][199](147)
  60. 680 CD[178]5:[141]9000:[153]"(null)ANT TO REVIEW UNIT POPULATION DATA?":[153]""
  61. 690 [141]8000
  62. 700 [139] YES$[178]"Y" [167] [141]7000
  63. 710 [137]970
  64. 715 [139]ST[177]64[167][160]2: [159]15,8,15:[132]15,X$:[160]15:[137]600
  65. 720 :
  66. 730 [143]"**--VAL(null)(null)VAL(null)CLOSESTR$ATN(null)ATN--**
  67. 740 :
  68. 750 PRINTCHR$(147):CD=5:GOSUB9000
  69. 760 PRINT"[200]OW MANY POLLS OR SAMPLING UNITS?":PRINT""
  70. 770 INPUT PN:IFPN=0THENPRINT"[147]":PRINT"[210][197][209][213][201][210][197][160][206][213][205][194][197][210][160]- [211][212][193][210][212][160][207][214][197][210]":END
  71. 780 DIM PD(PN)
  72. 790 FOR J=1TO PN
  73. 800 PRINT"[197]NTER POPULATION OF UNIT ";J
  74. 810 INPUT PD(J)
  75. 820 NEXTJ
  76. 830 PRINTCHR$(147):CD=5:GOSUB9000
  77. 840 FORKJ=1TO200:NEXTKJ
  78. 850 PRINT"[215]ANT TO REVIEW UNIT POPULATION DATA?":PRINT""
  79. 860 GOSUB8000
  80. 870 IF YES$="Y" THEN GOSUB7000
  81. 880 POKEB,6:POKES,6:POKEC,1
  82. 890 PRINTCHR$(147):CD=5:GOSUB9000
  83. 900 PRINT"[196]O YOU WANT TO SAVE THIS DATA"
  84. 910 PRINT"ON DISK?":PRINT"":GOSUB8000
  85. 920 IF YES$="N" THEN GOTO 970
  86. 930 PRINT"[197]NTER FILE NAME (MAXIMUM 12 CHARACTERS)":PRINT
  87. 940 INPUTFILE$:IF FILE$=""THEN GOTO 940
  88. 950 PRINT:PRINTCHR$(18)"[208]LEASE [215]AIT A [205]OMENT"CHR$(146)
  89. 960 GOSUB3000: REM FILE CREATION
  90. 970 POKEB,6:POKES,6:PRINTCHR$(147):CD=5:GOSUB9000
  91. 980 PRINT"[200]OW MANY RANDOM NUMBERS FOR EACH"
  92. 990 PRINT"SAMPLE UNIT DO YOU WANT?":PRINT""
  93. 1000 INPUT RN:PRINT
  94. 1010 PRINT"[196]O YOU WANT A PRINTOUT OF THE RESULTS?"
  95. 1020 PRINT"[201]F NO, NUMBERS WILL DISPLAY ON SCREEN."
  96. 1030 PRINT"":GOSUB8000
  97. 1040 IFYES$="N"THENGOTO1700
  98. 1050 :
  99. 1060 REM"**--[208][210][201][206][212][160][210][207][213][212][201][206][197]--**
  100. 1070 [143]"**--(null)AME,MID$OB,STR$ATE--**
  101. 1080 :
  102. 1090 PRINTCHR$(147):CD=3:GOSUB9000
  103. 1100 PRINTCHR$(18)CHR$(158)SPC(8)"[208][193][199][197][160][200][197][193][196][197][210][160][201][206][198][207][210][205][193][212][201][207][206]"CHR$(5):PRINT""
  104. 1110 PRINT"[212]YPE IN YOUR NAME OR YOUR COMPANY NAME"
  105. 1120 PRINT"[196]O NOT USE COMMAS OR COLONS."
  106. 1130 INPUT N$
  107. 1140 PRINT
  108. 1150 PRINT"[197]NTER TODAY'S DATE"
  109. 1160 INPUT"[205]ONTH";M$:INPUT"[196]AY";D$:INPUT"[217]EAR";Y$
  110. 1170 PRINT
  111. 1180 PRINT"[197]NTER THE NAME OF THIS JOB OR PROJECT"
  112. 1190 INPUTJ$
  113. 1200 PRINTCHR$(147)
  114. 1210 PRINTCHR$(18);CHR$(158);"[217][207][213][210][160][206][193][205][197][160][207][210][160][195][207][205][208][193][206][217][160][206][193][205][197]";CHR$(146);CHR$(5)
  115. 1220 PRINT
  116. 1230 PRINTN$:PRINT
  117. 1240 PRINTCHR$(18);CHR$(158);"[212][207][196][193][217]'[211][160][196][193][212][197]";CHR$(146);CHR$(5):PRINT
  118. 1250 PRINTM$;" ";D$;" ";Y$:PRINT
  119. 1260 PRINTCHR$(18);CHR$(158);"[202][207][194][160][206][193][205][197][160][207][210][160][196][197][211][195][210][201][208][212][201][207][206]";CHR$(146);CHR$(5)
  120. 1270 PRINT
  121. 1280 PRINTJ$:PRINT
  122. 1290 PRINTSPC(5)"[201]S THIS INFORMATION CORRECT?":PRINT""
  123. 1300 GOSUB8000
  124. 1310 IF YES$="N"THEN GOTO1090
  125. 1320 :
  126. 1330 REM"**--[208][210][207][205][208][212],[195][193][204][195],[208][210][201][206][212]--**
  127. 1340 :
  128. 1350 [153][199](147):CD[178]5:[141]9000
  129. 1360 [153]"(null)AKE SURE PRINTER IS READY, THEN"
  130. 1370 [153]"PRESS ANY KEY TO CONTINUE."
  131. 1380 [161]Z$:[139]Z$[178]""[167] [137]1380
  132. 1390 :
  133. 1400 [153][199](147):CD[178]10:[141]9000
  134. 1410 [153][166]16)[199](18)"(null)(null)RIGHT$(null)(null)RIGHT$(null)CHR$":[153]""
  135. 1420 [153][166]14)"(null)(null)VALATN(null)VALCLOSE(null)ATNRIGHT$(null)"[199](146)
  136. 1430 [159]4,4,7:[152]4,[199](27)"L"[199](10):[160]4:[143] SETS LEFT MARGIN
  137. 1440 [159]4,4,7
  138. 1450 [152]4,[199](18)N$
  139. 1460 [152]4,[199](146)
  140. 1470 [152]4,"MID$(null)PEEK: ";J$
  141. 1480 [152]4,"STR$ATN(null)VAL: ";M$[170]" "[170]D$[170]" "[170]Y$
  142. 1490 [152]4,"(null)ATN(null)STR$(null)(null)CLOSE(null)(null)(null)PEEKVAL(null)CLOSE(null)RIGHT$(null)(null)":[152]4,[199](10)
  143. 1500 [160]4
  144. 1510 [129] J[178]1 [164] PN
  145. 1520 X[178]X[170]1
  146. 1530 [159]4,4,7:[152]4,"(null)NIT (null)O:";X;"   (null)NIT (null)OP:";PD(J):[160]4
  147. 1540 [129]K[178]1[164] RN
  148. 1550 R[178][181](PD(J)[172][187](1))[170]1
  149. 1560 [159]4,4,7:[152]4,R;:[160]4
  150. 1570 [130] K
  151. 1580 [159]4,4,7:[152]4,[199](10):[160]4
  152. 1590 [130] J
  153. 1600 [153][199](147):CD[178]18:[141]9000
  154. 1610 [153]"":  [153]"(null)RESS ";[199](18)"ASC1";[199](146);" ATNGAIN ";
  155. 1620 [153][199](18);"ASC3";[199](146);" (null)UIT ";[199](18)"ASC5";[199](146);" (null)ESTART"
  156. 1630 [161]Z$:[139]Z$[178]""[167] 1630
  157. 1640 [139]Z$[179][177][199](133)[175]Z$[179][177][199](134)[175] Z$[179][177][199](135)[167] [137]1630
  158. 1650 [139]Z$[178][199](133)[167] X[178]0:[153][199](147):[137]1350
  159. 1660 [139]Z$[178][199](134)[167] 1680
  160. 1670 [139]Z$[178][199](135)[167] [156]:[137]100
  161. 1680 [153][199](147):[128]
  162. 1690 :
  163. 1700 [143]"--**(null)(null)RIGHT$(null)(null)CLOSE(null)(null)CLOSE(null)LEN(null)VALVAL(null)--**
  164. 1710 :
  165. 1720 PRINTCHR$(147):PRINT"[145][145]":PRINT:PRINT"[206]UMBERS WILL DISPLAY IN A";
  166. 1730 PRINT" FEW SECONDS.  [215]HEN SCREEN IS FULL"
  167. 1740 PRINT"":PRINT TAB(6)"[208]RESS "CHR$(18)"[211][208][193][195][197] [194][193][210] "CHR$(146)"TO SCROLL"
  168. 1750 FORKK=1 TO2500:NEXTKK:PRINTCHR$(147):POKE198,0
  169. 1760 FORJ=1TO PN:X=X+1
  170. 1770 PRINT CHR$(158)"[213][206][201][212] [206][207]:";X;CHR$(5)
  171. 1780 FORK=1TO RN:R=INT(PD(J)*RND(1))+1
  172. 1790 PRINT R;:NEXT K
  173. 1800 PRINTCHR$(32)
  174. 1810 IFPEEK(1945)<>32 ORPEEK(1906)<>32  THEN GETX$:IFX$<>CHR$(32)THENGOTO1810
  175. 1820 NEXTJ
  176. 1840 PRINT"":PRINT"[208]RESS ";CHR$(18)"[198]1";CHR$(146);" [193]GAIN ";
  177. 1850 PRINTCHR$(18);"[198]3";CHR$(146);" [209]UIT ";CHR$(18)"[198]5";CHR$(146);" [210]ESTART"
  178. 1860 GETZ$:IFZ$=""THEN 1860
  179. 1870 IFZ$<>CHR$(133)ANDZ$<>CHR$(134)AND Z$<>CHR$(135)THEN GOTO1860
  180. 1880 IFZ$=CHR$(133)THEN X=0:PRINTCHR$(147):GOTO1760
  181. 1890 IFZ$=CHR$(134)THEN 1910
  182. 1900 IFZ$=CHR$(135)THEN CLR:GOTO100
  183. 1910 PRINTCHR$(147):END
  184. 1920 :
  185. 3000 REM"**--[198][201][204][197][160][195][210][197][193][212][201][207][206][160][210][207][213][212][201][206][197]--**
  186. 3010 :
  187. 3020 [143]"**--(null)OINTER ASCILE--**
  188. 3030 OPEN2,8,2,"@0:"+FILE$+".PT"+",S,W"
  189. 3040 PRINT#2,PN
  190. 3050 CLOSE2
  191. 3060 REM"**--[196]ATA [198]ILE--**
  192. 3070 [159]3,8,3,"@0:"[170]FILE$[170]",S,W"
  193. 3080 [129] J[178]1[164] PN
  194. 3090 [152]3,PD(J)
  195. 3100 [130]J
  196. 3110 [160]3
  197. 3120 [142]
  198. 3130 :
  199. 7000 [143]"**--STR$ATN(null)ATNCLOSE(null)VAL(null)RIGHT$VAL(null)--**
  200. 7010 :
  201. 7020 PRINTCHR$(147):CD=9:GOSUB9000
  202. 7030 POKEB,8:POKES,8
  203. 7040 FOR J=1 TO PN
  204. 7050 PRINTCHR$(147)
  205. 7060 PRINT""
  206. 7070 PRINT SPC(5)CHR$(18)"[213][206][201][212] ";J;CHR$(146);"  ";PD(J)
  207. 7080 PRINT""
  208. 7090 PRINT"[208]RESS ";CHR$(18)"[211][208][193][195][197]";CHR$(146);" [206]EXT ";
  209. 7100 PRINTCHR$(18);"[198]1";CHR$(146);" [197]XIT ";CHR$(18)"[198]3";CHR$(146);" [195]HANGE"
  210. 7110 GETZ$:IFZ$=""THEN GOTO7110
  211. 7120 IFZ$<>CHR$(32)ANDZ$<>CHR$(133)AND Z$<>CHR$(134)THEN GOTO7110
  212. 7130 IFZ$=CHR$(32)AND J<>PN THEN NEXTJ
  213. 7140 IFZ$=CHR$(32)ANDJ=PN THEN GOTO7020
  214. 7150 IFZ$=CHR$(133)THEN RETURN
  215. 7160 PRINT"[145][145][145][145][145]":PRINT SPC(5)CHR$(18)"[206][197][215][160][196][193][212][193] ";CHR$(146);
  216. 7170 INPUT PD(J):IFJ=PN THEN GOTO7020
  217. 7180 NEXT J
  218. 7190 :
  219. 8000 REM"**--[217]/[206] [201][206][208][213][212][160][210][207][213][212][201][206][197]--**
  220. 8010 :
  221. 8020 YES$[178]""
  222. 8030 [153][199](158)
  223. 8040 [153][166]10)"(null)YPE A ";[199](18);"Y";[199](146);" OR ";[199](18);"N";[199](146)
  224. 8050 [153][199](5)
  225. 8060 [151]198,0:[143] CLEAR BUFFER
  226. 8070 [133] YES$
  227. 8080 [139] YES$[178][199](13)[167] [137]8070
  228. 8090 [139] [200](YES$,1)[178]"Y"[176] [200](YES$,1)[178]"(null)"[167] YES$[178]"Y":[142]
  229. 8100 [139] [200](YES$,1)[178]"N"[176] [200](YES$,1)[178]"(null)"[167] YES$[178]"N":[142]
  230. 8110 [153]
  231. 8120 [153][199](18)[199](28)"INCORRECT CHOICE"[199](146)[199](5)
  232. 8130 [153]
  233. 8140 [137]8000: [143] ASK AGAIN
  234. 8150 :
  235. 9000 [143]"**--LEN(null)(null)(null)(null)(null)CLOSESTR$(null)(null)(null)CLOSE(null)(null)(null)(null)RIGHT$(null)VAL--**
  236. 9010 :
  237. 9020 FOR I=1 TO CD
  238. 9030 PRINTCHR$(17);
  239. 9040 NEXT I
  240. 9050 RETURN
  241. 9060 :
  242. 10000 REM"**--[201][206][211][212][210][213][195][212][201][207][206][211]--**
  243. 10010 :
  244. 10020 [151]B,14:[151]S,14:[151]C,0
  245. 10030 [153][199](147):[153][163]13)"RIGHT$(null)(null)(null)(null)(null)LEN(null)RIGHT$(null)(null)(null)":[153]""
  246. 10040 [153]"(null)HIS PROGRAM WILL HELP SELECT RANDOM"
  247. 10050 [153]"SAMPLES FOR OPINION SURVEYS OR OTHER"
  248. 10060 [153]"KINDS OF RESEARCH.  (null)OU MUST SUPPLY THE"
  249. 10070 [153]"NUMBER OF SAMPLING UNITS (E.G. VOTERS"
  250. 10080 [153]"POLLS) AND THE POPULATION OF EACH UNIT."
  251. 10090 [153]
  252. 10100 [153]"ATNFTER ENTERING THE DATA YOU MAY REVIEW"
  253. 10110 [153]"AND/OR CHANGE IT.  (null)HE DATA MAY ALSO BE"
  254. 10120 [153]"SAVED TO DISK AND RETRIEVED FOR LATER"
  255. 10130 [153]"USE."
  256. 10140 [153]
  257. 10150 [153]"(null)OU WILL BE ASKED HOW MANY RANDOM"
  258. 10160 [153]"NUMBERS ARE REQUIRED FOR EACH UNIT."
  259. 10170 [153]"(null)ESULTS CAN BE DISPLAYED ON THE SCREEN"
  260. 10180 [153]"OR SENT TO THE PRINTER.  RIGHT$F YOU SELECT"
  261. 10190 [153]"A PRINTOUT THE PROGRAM WILL REQUEST "
  262. 10200 [153]"SOME ADDITIONAL INFORMATION."
  263. 10210 [141]12020
  264. 10220 [153][199](147)
  265. 10230 [153]"ASCOLLOWING THE DISPLAY/PRINT ROUTINES"
  266. 10240 [153]"YOU MAY GENERATE A NEW SEQUENCE OF"
  267. 10250 [153]"RANDOM NUMBERS FROM THE SAME DATA,"
  268. 10260 [153]"RESTART THE PROGRAM, OR QUIT"
  269. 10270 [153]"THE PROGRAM.  (null)IMPLY PRESS THE "
  270. 10280 [153]"FUNCTION KEY WHICH IS INDICATED AT THE"
  271. 10290 [153]"BOTTOM OF THE SCREEN."
  272. 10300 [141]12020
  273. 10310 [153][199](147)
  274. 10320 [153][163]12)"(null)(null)(null)(null)VAL(null)CLOSE(null)(null)(null)VAL(null)":[153]""
  275. 10330 [153]"(null)HIS PROGRAM WAS DESIGNED FOR A LEN64,"
  276. 10340 [153]"1541 DRIVE, AND VALPSON (null)(null) PRINTER WITH"
  277. 10350 [153]"A LENARD? +CHR$ RIGHT$NTERFACE.  (null)O ADAPT FOR"
  278. 10360 [153]"OTHER PRINTERS ADJUST THE SETTINGS IN"
  279. 10370 [153]"LINES 1330 - 1680."
  280. 10380 [153]"":CD[178]21:[141]9000
  281. 10390 [153]"(null)RESS ";[199](18)"(null)(null)ATNLENVAL ";[199](146);"(null)EXT (null)AGE ";
  282. 10400 [153][199](18)"ASC1"[199](146);" VALXIT"
  283. 10410 [161]Z$:[139] Z$[179][177][199](32)[175] Z$[179][177][199](133)[167]10410
  284. 10420 [139] Z$[178][199](32)[167]10000
  285. 10430 [137]450
  286. 10440 :
  287. 12000 [143]"--**(null)VAL(null)(null)CLOSE(null)ATNCHR$VAL**--
  288. 12010 :
  289. 12020 PRINT"":CD=21:GOSUB9000
  290. 12030 PRINT"[208]RESS ";CHR$(18)"[211][208][193][195][197] ";CHR$(146);"[206]EXT PAGE ";
  291. 12040 PRINTCHR$(18);"[198]1";CHR$(146);" [197]XIT "
  292. 12050 GETZ$:IFZ$=""THEN GOTO12050
  293. 12060 IFZ$<>CHR$(32)ANDZ$<>CHR$(133)THEN GOTO12050
  294. 12070 IFZ$=CHR$(32)THEN RETURN
  295. 12080 IFZ$=CHR$(133)THEN GOTO450
  296. 12100 :
  297. 15000 REM"--**[211][207][213][206][196][160][211][213][194][210][207][213][212][201][206][197]--**
  298. 15010 :
  299. 15020 T[178]54272
  300. 15030 [151] T[170]1,20
  301. 15040 [151] T[170]5,9
  302. 15050 [151] T[170]6,9
  303. 15060 [151] T[170]24,15
  304. 15070 [151] T[170]4,17
  305. 15075 [129] W[178]1 [164] 20: [130] W
  306. 15080 [129] W[178]1 [164] 20: [130] W
  307. 15090 [151] T[170]4,16
  308. 15100 [142]
  309.